home *** CD-ROM | disk | FTP | other *** search
/ Dictionaries & Language / Dictionaries and Language (Chestnut CD-ROM) (1993).iso / russian / cyrilic2 / addpage.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-04-20  |  2.0 KB  |  65 lines
  1. 10  DEF FNH$=RIGHT$("000"+HEX$(ASC(A$)),3)+"H"
  2. 20  INPUT "CPI filename:",S$
  3. 30  OPEN S$ AS #1 LEN=1:FIELD #1,1 AS A$:IF LOF(1)=0 THEN CLOSE #1:GOTO 20
  4. 40  INPUT "Target code page:",PAGETARGET
  5. 50  INPUT "In or Out?",S$:S$=CHR$(ASC(S$) OR 32)
  6. 60  IF S$="o" THEN 100
  7. 70  IF S$<>"i" THEN 50
  8. 80  INPUT "CP filename:",N$
  9. 90  OPEN N$ AS #3 LEN=1:FIELD #3,1 AS N$:IF LOF(3)=0 THEN CLOSE #3:GOTO 80
  10. 100  PAGE=0
  11. 110  I=34+PAGE*9780
  12. 120  B$="":FOR J=1 TO 8:GOSUB 630:B$=B$+A$:NEXT  J
  13. 130  IF B$<>"EGA     " THEN 440
  14. 140  GOSUB 630:PAGENO=ASC(A$):GOSUB 630:PAGENO=PAGENO+ASC(A$)*256
  15. 150  IF PAGENO<>PAGETARGET THEN PAGE=PAGE+1:GOTO 110
  16. 160  IF S$="i" THEN PRINT "Replacing...";:GOTO 480
  17. 170  OPEN MID$(STR$(PAGENO),2)+".lst" FOR OUTPUT AS #2
  18. 180  PRINT #2,"data segment"
  19. 190  PRINT #2,";Page #";PAGENO:PRINT PAGE;PAGENO
  20. 200  I=I-18 'back up
  21. 210  K=8:GOSUB 640
  22. 220  PRINT #2," db 'EGA     '"
  23. 230  PRINT #2," dw";PAGENO
  24. 240  I=I+10:K=16:GOSUB 640
  25. 250  FOR B=1 TO 3 '3 blocks: 16, 14, 8 line fonts
  26. 260  GOSUB 630:H=ASC(A$): GOSUB 630:W=ASC(A$)
  27. 270  PRINT #2," db ";H;",";W
  28. 280  PRINT H;"x";W;
  29. 290  K=4:GOSUB 640
  30. 300  FOR C=0 TO 255
  31. 310  PRINT C;
  32. 320  PRINT #2,";Character";C;:IF C>32 THEN PRINT #2,CHR$(C) ELSE PRINT #2,""
  33. 330  FOR IH=1 TO H:PRINT #2," db ";
  34. 340  FOR IW=0 TO W-1
  35. 350  IF (IW MOD 8)=0 THEN GOSUB 630:K=ASC(A$)
  36. 360  IF K>127 THEN PRINT #2,"1"; ELSE PRINT #2,"0";
  37. 370  K=(K+K) AND &HFF
  38. 380  NEXT IW
  39. 390  PRINT #2,"b": NEXT IH
  40. 400  NEXT C:PRINT
  41. 410  NEXT B
  42. 420  PRINT #2,"data ends":PRINT #2," end"
  43. 430  PRINT "Extracted.":GOTO 620
  44. 440  IF S$="o" THEN PRINT "Target page not in file.":GOTO 620
  45. 450  PRINT "Target page not in file---appending...";
  46. 460  GET #1,24:J=ASC(A$):GET #1,25:J=J+ASC(A$)*256 '# entries
  47. 470  J=J+1:LSET A$=CHR$(J MOD 256):PUT #1,25:LSET A$=CHR$(J/256):PUT #1,26
  48. 480  I=26+PAGE*9780
  49. 490  J=I+9780-1 'offset of next page
  50. 500  K=INT(J/256)
  51. 510  LSET A$=CHR$(&H1C):PUT #1,I:I=I+1
  52. 520  LSET A$=CHR$(&H0):PUT #1,I:I=I+1
  53. 530  LSET A$=CHR$(J-K*256):PUT #1,I:I=I+1
  54. 540  LSET A$=CHR$(K MOD 256):PUT #1,I:I=I+1
  55. 550  LSET A$=CHR$(K \ 256):PUT #1,I:I=I+1
  56. 560  FOR J=6 TO 24:GET #3,J:LSET A$=N$:PUT #1,I:I=I+1:NEXT J
  57. 570  J=53+9780*PAGE
  58. 580  K=INT(J/256)
  59. 590  LSET A$=CHR$(J-K*256):PUT #1,I:I=I+1
  60. 600  LSET A$=CHR$(K):PUT #1,I:I=I+1
  61. 610  FOR J=27 TO 9780:GET #3,J:LSET A$=N$:PUT #1,I:I=I+1:NEXT J:PRINT "Done."
  62. 620  END
  63. 630  GET #1,I:I=I+1:RETURN 'getb
  64. 640  PRINT #2," db ";:FOR J=1 TO K-1:GOSUB 630:PRINT #2,FNH$;",";:NEXT J:GOSUB 630:PRINT #2,FNH$:RETURN
  65.